\ Game of Life - TurboForth Version
\ ported from http://www.forth-ev.de/wiki/doku.php/projects:4e4th:4e4th:start:beispiele)

DECIMAL
16 CONSTANT #lines
8 CELLS CONSTANT b/cell  \ bits per cell: = number of columns

: line  ( n -- a-addr ) CELLS pad + ;
: lrot  ( x1 -- x2 )  \ rotate left by one
   DUP 2* SWAP 0< - ;
: lrot3  ( x1 x2 x3 --  x4 x5 x6 ) lrot ROT  lrot ROT  lrot ROT ;

HERE  0 C, 1 C, 1 C, 2 C,  1 C, 2 C, 2 C, 3 C,  CONSTANT #bits
: countbits  ( x -- n )  \ count number of bits=1 in bit0..2
   7 AND #bits + C@ ;

: alive  ( x1 x2 x3 -- flag )
   \ return whether cell at bit1 in line1 is alive in next generation
   OVER 2 AND 0= NOT >R
   countbits
   SWAP countbits +  \ note: cell itself is counted, too. correction below.
   SWAP countbits +
   DUP 3 =  SWAP 4 = R> AND OR ;
   
: 3dup  ( x1 x2 x3 -- x1 x2 x3 x1 x2 x3 )
   2 pick 2 pick 2 pick ;
   
: doline  ( x1 x2 x3 -- x1 x2 x3 x4 )
   0  b/cell 0 DO 
      >R   3dup alive 2 AND R> OR lrot >R
      lrot3   R>
   LOOP ;
   
: nextgen  ( -- )
   0 line @   #lines 1- line @  OVER   ( s: line0   x1 x2 )
   #lines 1- 0 DO
      I 1+ line @               ( s: line0  x1 x2 x3 )
      doline  I line !
      ROT DROP                  ( s: line0  x2 x3 )
   LOOP  
   ROT doline  #lines 1- line !   \ special treatment for last line
   2DROP DROP ;
   
: .line  ( x -- )
   b/cell 0 DO
      DUP 0< IF ASCII @  ELSE ASCII . THEN EMIT
      lrot
   LOOP  DROP ;
   
VARIABLE generation 
: .universe  ( -- )  \ print current life state to console 
    0 0 gotoxy 
   #lines 0 DO   CR I line @ .line  LOOP cr 
   generation @ .  1 generation +! ;
   
: life  ( -- ) \ run life with output to console, until key <q> pressed
   1 gmode BEGIN
      .universe     nextgen  
   key? ascii q = until ;

: void  ( -- )  pad #lines CELLS 0 FILL ;
: seed  ( x1 .. xn n -- )   0 DO i line ! LOOP ;
HEX   \ some wellknown patterns:
: glider  ( -- )  7 1 2  3 seed ;
: fpent  ( -- )  4 0C 6  3 seed ;
: lwss  ( -- )  0F 11 1 12  4 seed ;
: diehard  47 0C0 2  3 seed ;
: acorn  67 8 20  3 seed ;
: demo   glider   700 3 line ! ;
DECIMAL

void demo life